home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / win / tkWinDialog.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  28.2 KB  |  1,037 lines  |  [TEXT/CWIE]
  1. /*
  2.  * tkWinDialog.c --
  3.  *
  4.  *    Contains the Windows implementation of the common dialog boxes.
  5.  *
  6.  * Copyright (c) 1996-1997 Sun Microsystems, Inc.
  7.  *
  8.  * See the file "license.terms" for information on usage and redistribution
  9.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  *
  11.  * SCCS: @(#) tkWinDialog.c 1.9 97/07/30 17:25:53
  12.  *
  13.  */
  14.  
  15. #include "tkWinInt.h"
  16. #include "tkFileFilter.h"
  17.  
  18. #include <commdlg.h>    /* includes common dialog functionality */
  19. #include <dlgs.h>       /* includes common dialog template defines */
  20. #include <cderr.h>      /* includes the common dialog error codes */
  21.  
  22. #if ((TK_MAJOR_VERSION == 4) && (TK_MINOR_VERSION <= 2))
  23. /*
  24.  * The following function is implemented on tk4.3 and after only 
  25.  */
  26. #define Tk_GetHWND TkWinGetHWND
  27. #endif
  28.  
  29. #define SAVE_FILE 0
  30. #define OPEN_FILE 1
  31.  
  32. /*----------------------------------------------------------------------
  33.  * MsgTypeInfo --
  34.  *
  35.  *    This structure stores the type of available message box in an
  36.  *    easy-to-process format. Used by th Tk_MessageBox() function
  37.  *----------------------------------------------------------------------
  38.  */
  39. typedef struct MsgTypeInfo {
  40.     char * name;
  41.     int type;
  42.     int numButtons;
  43.     char * btnNames[3];
  44. } MsgTypeInfo;
  45.  
  46. #define NUM_TYPES 6
  47.  
  48. static MsgTypeInfo 
  49. msgTypeInfo[NUM_TYPES] = {
  50.     {"abortretryignore", MB_ABORTRETRYIGNORE, 3, {"abort", "retry", "ignore"}},
  51.     {"ok",          MB_OK,           1, {"ok"                      }},
  52.     {"okcancel",     MB_OKCANCEL,          2, {"ok",    "cancel"         }},
  53.     {"retrycancel",     MB_RETRYCANCEL,      2, {"retry", "cancel"         }},
  54.     {"yesno",         MB_YESNO,          2, {"yes",   "no"             }},
  55.     {"yesnocancel",     MB_YESNOCANCEL,      3, {"yes",   "no",    "cancel"}}
  56. };
  57.  
  58. /*
  59.  * The following structure is used in the GetOpenFileName() and
  60.  * GetSaveFileName() calls.
  61.  */
  62. typedef struct _OpenFileData {
  63.     Tcl_Interp * interp;
  64.     TCHAR szFile[MAX_PATH+1];
  65. } OpenFileData;
  66.  
  67. /*
  68.  * The following structure is used in the ChooseColor() call.
  69.  */
  70. typedef struct _ChooseColorData {
  71.     Tcl_Interp * interp;
  72.     char * title;            /* Title of the color dialog */
  73. } ChooseColorData;
  74.  
  75.  
  76. static int         GetFileName _ANSI_ARGS_((ClientData clientData,
  77.                     Tcl_Interp *interp, int argc, char **argv,
  78.                     int isOpen));
  79. static UINT CALLBACK    ColorDlgHookProc _ANSI_ARGS_((HWND hDlg, UINT uMsg,
  80.                 WPARAM wParam, LPARAM lParam));
  81. static int         MakeFilter _ANSI_ARGS_((Tcl_Interp *interp,
  82.                     OPENFILENAME *ofnPtr, char * string));
  83. static int        ParseFileDlgArgs _ANSI_ARGS_((Tcl_Interp * interp,
  84.                     OPENFILENAME *ofnPtr, int argc, char ** argv,
  85.                 int isOpen));
  86. static int         ProcessCDError _ANSI_ARGS_((Tcl_Interp * interp,
  87.                 DWORD dwErrorCode, HWND hWnd));
  88.  
  89. /*
  90.  *----------------------------------------------------------------------
  91.  *
  92.  * EvalArgv --
  93.  *
  94.  *    Invokes the Tcl procedure with the arguments. argv[0] is set by
  95.  *    the caller of this function. It may be different than cmdName.
  96.  *    The TCL command will see argv[0], not cmdName, as its name if it
  97.  *    invokes [lindex [info level 0] 0]
  98.  *
  99.  * Results:
  100.  *    TCL_ERROR if the command does not exist and cannot be autoloaded.
  101.  *    Otherwise, return the result of the evaluation of the command.
  102.  *
  103.  * Side effects:
  104.  *    The command may be autoloaded.
  105.  *
  106.  *----------------------------------------------------------------------
  107.  */
  108.  
  109. static int 
  110. EvalArgv(interp, cmdName, argc, argv)
  111.     Tcl_Interp *interp;        /* Current interpreter. */
  112.     char * cmdName;        /* Name of the TCL command to call */
  113.     int argc;            /* Number of arguments. */
  114.     char **argv;        /* Argument strings. */
  115. {
  116.     Tcl_CmdInfo cmdInfo;
  117.  
  118.     if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
  119.     char * cmdArgv[2];
  120.  
  121.     /*
  122.      * This comand is not in the interpreter yet -- looks like we
  123.      * have to auto-load it
  124.      */
  125.     if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) {
  126.         Tcl_ResetResult(interp);
  127.         Tcl_AppendResult(interp, "cannot execute command \"auto_load\"",
  128.         NULL);
  129.         return TCL_ERROR;
  130.     }
  131.  
  132.     cmdArgv[0] = "auto_load";
  133.     cmdArgv[1] = cmdName;
  134.  
  135.     if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){ 
  136.         return TCL_ERROR;
  137.     }
  138.  
  139.     if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
  140.         Tcl_ResetResult(interp);
  141.         Tcl_AppendResult(interp, "cannot auto-load command \"",
  142.         cmdName, "\"",NULL);
  143.         return TCL_ERROR;
  144.     }
  145.     }
  146.  
  147.     return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv);
  148. }
  149.  
  150. /*
  151.  *----------------------------------------------------------------------
  152.  *
  153.  * Tk_ChooseColorCmd --
  154.  *
  155.  *    This procedure implements the color dialog box for the Windows
  156.  *    platform. See the user documentation for details on what it
  157.  *    does.
  158.  *
  159.  * Results:
  160.  *    See user documentation.
  161.  *
  162.  * Side effects:
  163.  *    A dialog window is created the first time this procedure is called.
  164.  *    This window is not destroyed and will be reused the next time the
  165.  *    application invokes the "tk_chooseColor" command.
  166.  *
  167.  *----------------------------------------------------------------------
  168.  */
  169.  
  170. int
  171. Tk_ChooseColorCmd(clientData, interp, argc, argv)
  172.     ClientData clientData;    /* Main window associated with interpreter. */
  173.     Tcl_Interp *interp;        /* Current interpreter. */
  174.     int argc;            /* Number of arguments. */
  175.     char **argv;        /* Argument strings. */
  176. {
  177.     Tk_Window parent = Tk_MainWindow(interp);
  178.     ChooseColorData custData;
  179.     int oldMode;
  180.     CHOOSECOLOR chooseColor;
  181.     char * colorStr = NULL;
  182.     int i;
  183.     int winCode, tclCode;
  184.     XColor * colorPtr = NULL;
  185.     static inited = 0;
  186.     static long dwCustColors[16];
  187.     static long oldColor;        /* the color selected last time */
  188.  
  189.     custData.title     = NULL;
  190.  
  191.     if (!inited) {
  192.     /*
  193.      * dwCustColors stores the custom color which the user can
  194.      * modify. We store these colors in a fixed array so that the next
  195.      * time the color dialog pops up, the same set of custom colors
  196.      * remain in the dialog.
  197.      */
  198.     for (i=0; i<16; i++) {
  199.         dwCustColors[i] = (RGB(255-i*10, i, i*10)) ;
  200.     }
  201.     oldColor = RGB(0xa0,0xa0,0xa0);
  202.     inited = 1;
  203.     }
  204.  
  205.     /*
  206.      * 1. Parse the arguments
  207.      */
  208.  
  209.     chooseColor.lStructSize  = sizeof(CHOOSECOLOR) ;
  210.     chooseColor.hwndOwner    = 0;            /* filled in below */
  211.     chooseColor.hInstance    = 0;
  212.     chooseColor.rgbResult    = oldColor;
  213.     chooseColor.lpCustColors = (LPDWORD) dwCustColors ;
  214.     chooseColor.Flags        = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
  215.     chooseColor.lCustData    = (LPARAM)&custData;
  216.     chooseColor.lpfnHook     = ColorDlgHookProc;
  217.     chooseColor.lpTemplateName = NULL;
  218.  
  219.     for (i=1; i<argc; i+=2) {
  220.         int v = i+1;
  221.     int len = strlen(argv[i]);
  222.  
  223.     if (strncmp(argv[i], "-initialcolor", len)==0) {
  224.         if (v==argc) {goto arg_missing;}
  225.  
  226.         colorStr = argv[v];
  227.     }
  228.     else if (strncmp(argv[i], "-parent", len)==0) {
  229.         if (v==argc) {goto arg_missing;}
  230.  
  231.         parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
  232.         if (parent == NULL) {
  233.         return TCL_ERROR;
  234.         }
  235.     }
  236.     else if (strncmp(argv[i], "-title", len)==0) {
  237.         if (v==argc) {goto arg_missing;}
  238.  
  239.         custData.title = argv[v];
  240.     }
  241.     else {
  242.             Tcl_AppendResult(interp, "unknown option \"", 
  243.         argv[i], "\", must be -initialcolor, -parent or -title",
  244.         NULL);
  245.         return TCL_ERROR;
  246.     }
  247.     }
  248.  
  249.     if (Tk_WindowId(parent) == None) {
  250.     Tk_MakeWindowExist(parent);
  251.     }
  252.     chooseColor.hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
  253.  
  254.     if (colorStr != NULL) {
  255.     colorPtr = Tk_GetColor(interp, Tk_MainWindow(interp), colorStr);
  256.     if (!colorPtr) {
  257.         return TCL_ERROR;
  258.     }
  259.     chooseColor.rgbResult = RGB((colorPtr->red/0x100), 
  260.         (colorPtr->green/0x100), (colorPtr->blue/0x100));
  261.     }    
  262.  
  263.     /*
  264.      * 2. Popup the dialog
  265.      */
  266.  
  267.     oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
  268.     winCode = ChooseColor(&chooseColor);
  269.     (void) Tcl_SetServiceMode(oldMode);
  270.  
  271.     /*
  272.      * 3. Process the result of the dialog
  273.      */
  274.     if (winCode) {
  275.     /*
  276.      * User has selected a color
  277.      */
  278.     char result[100];
  279.  
  280.     sprintf(result, "#%02x%02x%02x",
  281.         GetRValue(chooseColor.rgbResult), 
  282.         GetGValue(chooseColor.rgbResult), 
  283.         GetBValue(chooseColor.rgbResult));
  284.         Tcl_AppendResult(interp, result, NULL);
  285.     tclCode = TCL_OK;
  286.  
  287.     oldColor = chooseColor.rgbResult;
  288.     } else {
  289.     /*
  290.      * User probably pressed Cancel, or an error occurred
  291.      */
  292.     tclCode = ProcessCDError(interp, CommDlgExtendedError(), 
  293.          chooseColor.hwndOwner);
  294.     }
  295.  
  296.     if (colorPtr) {
  297.     Tk_FreeColor(colorPtr);
  298.     }
  299.  
  300.     return tclCode;
  301.  
  302.   arg_missing:
  303.     Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
  304.     NULL);
  305.     return TCL_ERROR;
  306. }
  307.  
  308. /*
  309.  *----------------------------------------------------------------------
  310.  *
  311.  * ColorDlgHookProc --
  312.  *
  313.  *    Gets called during the execution of the color dialog. It processes
  314.  *    the "interesting" messages that Windows send to the dialog.
  315.  *
  316.  * Results:
  317.  *    TRUE if the message has been processed, FALSE otherwise.
  318.  *
  319.  * Side effects:
  320.  *    Changes the title of the dialog window when it is popped up.
  321.  *
  322.  *----------------------------------------------------------------------
  323.  */
  324.  
  325. static UINT
  326. CALLBACK ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
  327.     HWND hDlg;            /* Handle to the color dialog */
  328.     UINT uMsg;            /* Type of message */
  329.     WPARAM wParam;        /* word param, interpretation depends on uMsg*/
  330.     LPARAM lParam;        /* long param, interpretation depends on uMsg*/
  331. {
  332.     CHOOSECOLOR * ccPtr;
  333.     ChooseColorData * pCustData;
  334.  
  335.     switch (uMsg) {
  336.       case WM_INITDIALOG:
  337.     /* Save the pointer to CHOOSECOLOR so that we can use it later */
  338.     SetWindowLong(hDlg, DWL_USER, lParam);
  339.  
  340.     /* Set the title string of the dialog */
  341.     ccPtr = (CHOOSECOLOR*)lParam;
  342.     pCustData = (ChooseColorData*)(ccPtr->lCustData);
  343.     if (pCustData->title && *(pCustData->title)) {
  344.          SetWindowText(hDlg, (LPCSTR)pCustData->title);
  345.     }
  346.  
  347.     return TRUE;
  348.     }
  349.  
  350.     return FALSE;
  351. }
  352.  
  353. /*
  354.  *----------------------------------------------------------------------
  355.  *
  356.  * Tk_GetOpenFileCmd --
  357.  *
  358.  *    This procedure implements the "open file" dialog box for the
  359.  *    Windows platform. See the user documentation for details on what
  360.  *    it does.
  361.  *
  362.  * Results:
  363.  *    See user documentation.
  364.  *
  365.  * Side effects:
  366.  *    A dialog window is created the first this procedure is called.
  367.  *    This window is not destroyed and will be reused the next time
  368.  *    the application invokes the "tk_getOpenFile" or
  369.  *    "tk_getSaveFile" command.
  370.  *
  371.  *----------------------------------------------------------------------
  372.  */
  373.  
  374. int
  375. Tk_GetOpenFileCmd(clientData, interp, argc, argv)
  376.     ClientData clientData;    /* Main window associated with interpreter. */
  377.     Tcl_Interp *interp;        /* Current interpreter. */
  378.     int argc;            /* Number of arguments. */
  379.     char **argv;        /* Argument strings. */
  380. {
  381.     return GetFileName(clientData, interp, argc, argv, OPEN_FILE);
  382. }
  383.  
  384. /*
  385.  *----------------------------------------------------------------------
  386.  *
  387.  * Tk_GetSaveFileCmd --
  388.  *
  389.  *    Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
  390.  *    instead
  391.  *
  392.  * Results:
  393.  *    Same as Tk_GetOpenFileCmd.
  394.  *
  395.  * Side effects:
  396.  *    Same as Tk_GetOpenFileCmd.
  397.  *
  398.  *----------------------------------------------------------------------
  399.  */
  400.  
  401. int
  402. Tk_GetSaveFileCmd(clientData, interp, argc, argv)
  403.     ClientData clientData;    /* Main window associated with interpreter. */
  404.     Tcl_Interp *interp;        /* Current interpreter. */
  405.     int argc;            /* Number of arguments. */
  406.     char **argv;        /* Argument strings. */
  407. {
  408.     return GetFileName(clientData, interp, argc, argv, SAVE_FILE);
  409. }
  410.  
  411. /*
  412.  *----------------------------------------------------------------------
  413.  *
  414.  * GetFileName --
  415.  *
  416.  *    Calls GetOpenFileName() or GetSaveFileName().
  417.  *
  418.  * Results:
  419.  *    See user documentation.
  420.  *
  421.  * Side effects:
  422.  *    See user documentation.
  423.  *
  424.  *----------------------------------------------------------------------
  425.  */
  426.  
  427. static int 
  428. GetFileName(clientData, interp, argc, argv, isOpen)
  429.     ClientData clientData;    /* Main window associated with interpreter. */
  430.     Tcl_Interp *interp;        /* Current interpreter. */
  431.     int argc;            /* Number of arguments. */
  432.     char **argv;        /* Argument strings. */
  433.     int isOpen;            /* true if we should call GetOpenFileName(),
  434.                  * false if we should call GetSaveFileName() */
  435. {
  436.     OPENFILENAME openFileName, *ofnPtr;
  437.     int tclCode, winCode, oldMode;
  438.     OpenFileData *custData;
  439.     char buffer[MAX_PATH+1];
  440.     
  441.     ofnPtr = &openFileName;
  442.  
  443.     /*
  444.      * 1. Parse the arguments.
  445.      */
  446.     if (ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen) != TCL_OK) {
  447.     return TCL_ERROR;
  448.     }
  449.     custData = (OpenFileData*) ofnPtr->lCustData;
  450.  
  451.     /*
  452.      * 2. Call the common dialog function.
  453.      */
  454.     oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
  455.     GetCurrentDirectory(MAX_PATH+1, buffer);
  456.     if (isOpen) {
  457.     winCode = GetOpenFileName(ofnPtr);
  458.     } else {
  459.     winCode = GetSaveFileName(ofnPtr);
  460.     }
  461.     SetCurrentDirectory(buffer);
  462.     (void) Tcl_SetServiceMode(oldMode);
  463.  
  464.     if (ofnPtr->lpstrInitialDir != NULL) {
  465.     ckfree((char*) ofnPtr->lpstrInitialDir);
  466.     }
  467.  
  468.     /*
  469.      * 3. Process the results.
  470.      */
  471.     if (winCode) {
  472.     char *p;
  473.     Tcl_ResetResult(interp);
  474.  
  475.     for (p = custData->szFile; p && *p; p++) {
  476.         /*
  477.          * Change the pathname to the Tcl "normalized" pathname, where
  478.          * back slashes are used instead of forward slashes
  479.          */
  480.         if (*p == '\\') {
  481.         *p = '/';
  482.         }
  483.     }
  484.     Tcl_AppendResult(interp, custData->szFile, NULL);
  485.     tclCode = TCL_OK;
  486.     } else {
  487.     tclCode = ProcessCDError(interp, CommDlgExtendedError(),
  488.         ofnPtr->hwndOwner);
  489.     }
  490.  
  491.     if (custData) {
  492.     ckfree((char*)custData);
  493.     }
  494.     if (ofnPtr->lpstrFilter) {
  495.     ckfree((char*)ofnPtr->lpstrFilter);
  496.     }
  497.  
  498.     return tclCode;
  499. }
  500.  
  501. /*
  502.  *----------------------------------------------------------------------
  503.  *
  504.  * ParseFileDlgArgs --
  505.  *
  506.  *    Parses the arguments passed to tk_getOpenFile and tk_getSaveFile.
  507.  *
  508.  * Results:
  509.  *    A standard TCL return value.
  510.  *
  511.  * Side effects:
  512.  *    The OPENFILENAME structure is initialized and modified according
  513.  *    to the arguments.
  514.  *
  515.  *----------------------------------------------------------------------
  516.  */
  517.  
  518. static int 
  519. ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen)
  520.     Tcl_Interp * interp;    /* Current interpreter. */
  521.     OPENFILENAME *ofnPtr;    /* Info about the file dialog */
  522.     int argc;            /* Number of arguments. */
  523.     char **argv;        /* Argument strings. */
  524.     int isOpen;            /* true if we should call GetOpenFileName(),
  525.                  * false if we should call GetSaveFileName() */
  526. {
  527.     OpenFileData * custData;
  528.     int i;
  529.     Tk_Window parent = Tk_MainWindow(interp);
  530.     int doneFilter = 0;
  531.     int windowsMajorVersion;
  532.     Tcl_DString buffer;
  533.  
  534.     custData = (OpenFileData*)ckalloc(sizeof(OpenFileData));
  535.     custData->interp = interp;
  536.     strcpy(custData->szFile, "");
  537.  
  538.     /* Fill in the OPENFILENAME structure to */
  539.     ofnPtr->lStructSize       = sizeof(OPENFILENAME);
  540.     ofnPtr->hwndOwner         = 0;            /* filled in below */
  541.     ofnPtr->lpstrFilter       = NULL;
  542.     ofnPtr->lpstrCustomFilter = NULL;
  543.     ofnPtr->nMaxCustFilter    = 0;
  544.     ofnPtr->nFilterIndex      = 0;
  545.     ofnPtr->lpstrFile         = custData->szFile;
  546.     ofnPtr->nMaxFile          = sizeof(custData->szFile);
  547.     ofnPtr->lpstrFileTitle    = NULL;
  548.     ofnPtr->nMaxFileTitle     = 0;
  549.     ofnPtr->lpstrInitialDir   = NULL;
  550.     ofnPtr->lpstrTitle        = NULL;
  551.     ofnPtr->nFileOffset       = 0;
  552.     ofnPtr->nFileExtension    = 0;
  553.     ofnPtr->lpstrDefExt       = NULL;
  554.     ofnPtr->lpfnHook           = NULL; 
  555.     ofnPtr->lCustData         = (DWORD)custData;
  556.     ofnPtr->lpTemplateName    = NULL;
  557.     ofnPtr->Flags             = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST;
  558.  
  559.     windowsMajorVersion = LOBYTE(LOWORD(GetVersion()));
  560.     if (windowsMajorVersion >= 4) {
  561.     /*
  562.      * Use the "explorer" style file selection box on platforms that
  563.      * support it (Win95 and NT4.0, both have a major version number
  564.      * of 4)
  565.      */
  566.     ofnPtr->Flags |= OFN_EXPLORER;
  567.     }
  568.  
  569.  
  570.     if (isOpen) {
  571.     ofnPtr->Flags |= OFN_FILEMUSTEXIST;
  572.     } else {
  573.     ofnPtr->Flags |= OFN_OVERWRITEPROMPT;
  574.     }
  575.  
  576.     for (i=1; i<argc; i+=2) {
  577.         int v = i+1;
  578.     int len = strlen(argv[i]);
  579.  
  580.     if (strncmp(argv[i], "-defaultextension", len)==0) {
  581.         if (v==argc) {goto arg_missing;}
  582.  
  583.         ofnPtr->lpstrDefExt = argv[v];
  584.         if (ofnPtr->lpstrDefExt[0] == '.') {
  585.         /* Windows will insert the dot for us */
  586.         ofnPtr->lpstrDefExt ++;
  587.         }
  588.     }
  589.     else if (strncmp(argv[i], "-filetypes", len)==0) {
  590.         if (v==argc) {goto arg_missing;}
  591.  
  592.         if (MakeFilter(interp, ofnPtr, argv[v]) != TCL_OK) {
  593.         return TCL_ERROR;
  594.         }
  595.         doneFilter = 1;
  596.     }
  597.     else if (strncmp(argv[i], "-initialdir", len)==0) {
  598.         if (v==argc) {goto arg_missing;}
  599.  
  600.         if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
  601.         return TCL_ERROR;
  602.         }
  603.         ofnPtr->lpstrInitialDir = ckalloc(Tcl_DStringLength(&buffer)+1);
  604.         strcpy((char*)ofnPtr->lpstrInitialDir, Tcl_DStringValue(&buffer));
  605.         Tcl_DStringFree(&buffer);
  606.     }
  607.     else if (strncmp(argv[i], "-initialfile", len)==0) {
  608.         if (v==argc) {goto arg_missing;}
  609.  
  610.         if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
  611.         return TCL_ERROR;
  612.         }
  613.         strcpy(ofnPtr->lpstrFile, Tcl_DStringValue(&buffer));
  614.         Tcl_DStringFree(&buffer);
  615.     }
  616.     else if (strncmp(argv[i], "-parent", len)==0) {
  617.         if (v==argc) {goto arg_missing;}
  618.  
  619.         parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
  620.         if (parent == NULL) {
  621.         return TCL_ERROR;
  622.         }
  623.     }
  624.     else if (strncmp(argv[i], "-title", len)==0) {
  625.         if (v==argc) {goto arg_missing;}
  626.  
  627.         ofnPtr->lpstrTitle = argv[v];
  628.     }
  629.     else {
  630.             Tcl_AppendResult(interp, "unknown option \"", 
  631.         argv[i], "\", must be -defaultextension, ",
  632.         "-filetypes, -initialdir, -initialfile, -parent or -title",
  633.         NULL);
  634.         return TCL_ERROR;
  635.     }
  636.     }
  637.  
  638.     if (!doneFilter) {
  639.     if (MakeFilter(interp, ofnPtr, "") != TCL_OK) {
  640.         return TCL_ERROR;
  641.     }
  642.     }
  643.  
  644.     if (Tk_WindowId(parent) == None) {
  645.     Tk_MakeWindowExist(parent);
  646.     }
  647.     ofnPtr->hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
  648.  
  649.     return TCL_OK;
  650.  
  651.   arg_missing:
  652.     Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
  653.     NULL);
  654.     return TCL_ERROR;
  655. }
  656.  
  657. /*
  658.  *----------------------------------------------------------------------
  659.  *
  660.  * MakeFilter --
  661.  *
  662.  *    Allocate a buffer to store the filters in a format understood by
  663.  *    Windows
  664.  *
  665.  * Results:
  666.  *    A standard TCL return value.
  667.  *
  668.  * Side effects:
  669.  *    ofnPtr->lpstrFilter is modified.
  670.  *
  671.  *----------------------------------------------------------------------
  672.  */
  673. static int MakeFilter(interp, ofnPtr, string) 
  674.     Tcl_Interp *interp;        /* Current interpreter. */
  675.     OPENFILENAME *ofnPtr;    /* Info about the file dialog */
  676.     char *string;        /* String value of the -filetypes option */
  677. {
  678.     char *filterStr;
  679.     char *p;
  680.     int pass;
  681.     FileFilterList flist;
  682.     FileFilter *filterPtr;
  683.  
  684.     TkInitFileFilters(&flist);
  685.     if (TkGetFileFilters(interp, &flist, string, 1) != TCL_OK) {
  686.     return TCL_ERROR;
  687.     }
  688.  
  689.     if (flist.filters == NULL) {
  690.     /*
  691.      * Use "All Files (*.*) as the default filter is none is specified
  692.      */
  693.     char *defaultFilter = "All Files (*.*)";
  694.  
  695.     p = filterStr = (char*)ckalloc(30 * sizeof(char));
  696.  
  697.     strcpy(p, defaultFilter);
  698.     p+= strlen(defaultFilter);
  699.  
  700.     *p++ = '\0';
  701.     *p++ = '*';
  702.     *p++ = '.';
  703.     *p++ = '*';
  704.     *p++ = '\0';
  705.     *p++ = '\0';
  706.     *p = '\0';
  707.  
  708.     } else {
  709.     /* We format the filetype into a string understood by Windows:
  710.      * {"Text Documents" {.doc .txt} {TEXT}} becomes
  711.      * "Text Documents (*.doc,*.txt)\0*.doc;*.txt\0"
  712.      *
  713.      * See the Windows OPENFILENAME manual page for details on the filter
  714.      * string format.
  715.      */
  716.  
  717.     /*
  718.      * Since we may only add asterisks (*) to the filter, we need at most
  719.      * twice the size of the string to format the filter
  720.      */
  721.     filterStr = ckalloc(strlen(string) * 3);
  722.  
  723.     for (filterPtr = flist.filters, p = filterStr; filterPtr;
  724.             filterPtr = filterPtr->next) {
  725.         char *sep;
  726.         FileFilterClause *clausePtr;
  727.  
  728.         /*
  729.          *  First, put in the name of the file type
  730.          */
  731.         strcpy(p, filterPtr->name);
  732.         p+= strlen(filterPtr->name);
  733.         *p++ = ' ';
  734.         *p++ = '(';
  735.  
  736.         for (pass = 1; pass <= 2; pass++) {
  737.         /*
  738.          * In the first pass, we format the extensions in the 
  739.          * name field. In the second pass, we format the extensions in
  740.          * the filter pattern field
  741.          */
  742.         sep = "";
  743.         for (clausePtr=filterPtr->clauses;clausePtr;
  744.                  clausePtr=clausePtr->next) {
  745.             GlobPattern *globPtr;
  746.         
  747.  
  748.             for (globPtr=clausePtr->patterns; globPtr;
  749.                 globPtr=globPtr->next) {
  750.             strcpy(p, sep);
  751.             p+= strlen(sep);
  752.             strcpy(p, globPtr->pattern);
  753.             p+= strlen(globPtr->pattern);
  754.  
  755.             if (pass==1) {
  756.                 sep = ",";
  757.             } else {
  758.                 sep = ";";
  759.             }
  760.             }
  761.         }
  762.         if (pass == 1) {
  763.             if (pass == 1) {
  764.             *p ++ = ')';
  765.             }
  766.         }
  767.         *p ++ = '\0';
  768.         }
  769.     }
  770.  
  771.     /*
  772.      * Windows requires the filter string to be ended by two NULL
  773.      * characters.
  774.      */
  775.     *p++ = '\0';
  776.     *p = '\0';
  777.     }
  778.  
  779.     if (ofnPtr->lpstrFilter != NULL) {
  780.     ckfree((char*)ofnPtr->lpstrFilter);
  781.     }
  782.     ofnPtr->lpstrFilter = filterStr;
  783.  
  784.     TkFreeFileFilters(&flist);
  785.     return TCL_OK;
  786. }
  787.  
  788. /*
  789.  *----------------------------------------------------------------------
  790.  *
  791.  * Tk_MessageBoxCmd --
  792.  *
  793.  *    This procedure implements the MessageBox window for the
  794.  *    Windows platform. See the user documentation for details on what
  795.  *    it does.
  796.  *
  797.  * Results:
  798.  *    See user documentation.
  799.  *
  800.  * Side effects:
  801.  *    None. The MessageBox window will be destroy before this procedure
  802.  *    returns.
  803.  *
  804.  *----------------------------------------------------------------------
  805.  */
  806.  
  807. int
  808. Tk_MessageBoxCmd(clientData, interp, argc, argv)
  809.     ClientData clientData;    /* Main window associated with interpreter. */
  810.     Tcl_Interp *interp;        /* Current interpreter. */
  811.     int argc;            /* Number of arguments. */
  812.     char **argv;        /* Argument strings. */
  813. {
  814.     int flags;
  815.     Tk_Window parent = Tk_MainWindow(interp);
  816.     HWND hWnd;
  817.     char *message = "";
  818.     char *title = "";
  819.     int icon = MB_ICONINFORMATION;
  820.     int type = MB_OK;
  821.     int i, j;
  822.     char *result;
  823.     int code, oldMode;
  824.     char *defaultBtn = NULL;
  825.     int defaultBtnIdx = -1;
  826.  
  827.     for (i=1; i<argc; i+=2) {
  828.     int v = i+1;
  829.     int len = strlen(argv[i]);
  830.  
  831.     if (strncmp(argv[i], "-default", len)==0) {
  832.         if (v==argc) {goto arg_missing;}
  833.  
  834.         defaultBtn = argv[v];
  835.     }
  836.     else if (strncmp(argv[i], "-icon", len)==0) {
  837.         if (v==argc) {goto arg_missing;}
  838.  
  839.         if (strcmp(argv[v], "error") == 0) {
  840.         icon = MB_ICONERROR;
  841.         }
  842.         else if (strcmp(argv[v], "info") == 0) {
  843.         icon = MB_ICONINFORMATION;
  844.         }
  845.         else if (strcmp(argv[v], "question") == 0) {
  846.         icon = MB_ICONQUESTION;
  847.         }
  848.         else if (strcmp(argv[v], "warning") == 0) {
  849.         icon = MB_ICONWARNING;
  850.         }
  851.         else {
  852.             Tcl_AppendResult(interp, "invalid icon \"", argv[v],
  853.             "\", must be error, info, question or warning", NULL);
  854.         return TCL_ERROR;
  855.         }
  856.     }
  857.     else if (strncmp(argv[i], "-message", len)==0) {
  858.         if (v==argc) {goto arg_missing;}
  859.  
  860.         message = argv[v];
  861.     }
  862.     else if (strncmp(argv[i], "-parent", len)==0) {
  863.         if (v==argc) {goto arg_missing;}
  864.  
  865.         parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
  866.         if (parent == NULL) {
  867.         return TCL_ERROR;
  868.         }
  869.     }
  870.     else if (strncmp(argv[i], "-title", len)==0) {
  871.         if (v==argc) {goto arg_missing;}
  872.  
  873.         title = argv[v];
  874.     }
  875.     else if (strncmp(argv[i], "-type", len)==0) {
  876.         int found = 0;
  877.  
  878.         if (v==argc) {goto arg_missing;}
  879.  
  880.         for (j=0; j<NUM_TYPES; j++) {
  881.         if (strcmp(argv[v], msgTypeInfo[j].name) == 0) {
  882.             type = msgTypeInfo[j].type;
  883.             found = 1;
  884.             break;
  885.         }
  886.         }
  887.         if (!found) {
  888.         Tcl_AppendResult(interp, "invalid message box type \"", 
  889.             argv[v], "\", must be abortretryignore, ok, ",
  890.             "okcancel, retrycancel, yesno or yesnocancel", NULL);
  891.         return TCL_ERROR;
  892.         }
  893.     }
  894.     else {
  895.             Tcl_AppendResult(interp, "unknown option \"", 
  896.         argv[i], "\", must be -default, -icon, ",
  897.         "-message, -parent, -title or -type", NULL);
  898.         return TCL_ERROR;
  899.     }
  900.     }
  901.  
  902.     /* Make sure we have a valid hWnd to act as the parent of this message box
  903.      */
  904.     if (Tk_WindowId(parent) == None) {
  905.     Tk_MakeWindowExist(parent);
  906.     }
  907.     hWnd = Tk_GetHWND(Tk_WindowId(parent));
  908.  
  909.     if (defaultBtn != NULL) {
  910.     for (i=0; i<NUM_TYPES; i++) {
  911.         if (type == msgTypeInfo[i].type) {
  912.         for (j=0; j<msgTypeInfo[i].numButtons; j++) {
  913.             if (strcmp(defaultBtn, msgTypeInfo[i].btnNames[j])==0) {
  914.                 defaultBtnIdx = j;
  915.             break;
  916.             }
  917.         }
  918.         if (defaultBtnIdx < 0) {
  919.             Tcl_AppendResult(interp, "invalid default button \"",
  920.             defaultBtn, "\"", NULL);
  921.             return TCL_ERROR;
  922.         }
  923.         break;
  924.         }
  925.     }
  926.  
  927.     switch (defaultBtnIdx) {
  928.       case 0: flags = MB_DEFBUTTON1; break;
  929.       case 1: flags = MB_DEFBUTTON2; break;
  930.       case 2: flags = MB_DEFBUTTON3; break;
  931.       case 3: flags = MB_DEFBUTTON4; break;
  932.     }
  933.     } else {
  934.     flags = 0;
  935.     }
  936.     
  937.     flags |= icon | type;
  938.     oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
  939.     code = MessageBox(hWnd, message, title, flags|MB_SYSTEMMODAL);
  940.     (void) Tcl_SetServiceMode(oldMode);
  941.  
  942.     switch (code) {
  943.       case IDABORT:    result = "abort";  break;
  944.       case IDCANCEL:    result = "cancel"; break;
  945.       case IDIGNORE:    result = "ignore"; break;
  946.       case IDNO:    result = "no";     break;
  947.       case IDOK:    result = "ok";     break;
  948.       case IDRETRY:    result = "retry";  break;
  949.       case IDYES:    result = "yes";    break;
  950.       default:        result = "";
  951.     }
  952.  
  953.     /*
  954.      * When we come to here interp->result may have been changed by some
  955.      * background scripts. Call Tcl_SetResult() to make sure that any stuff
  956.      * lingering in interp->result will not appear in the result of
  957.      * this command.
  958.      */
  959.  
  960.     Tcl_SetResult(interp, result, TCL_STATIC);
  961.     return TCL_OK;
  962.  
  963.   arg_missing:
  964.     Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
  965.     NULL);
  966.     return TCL_ERROR;
  967. }
  968.  
  969. /*
  970.  *----------------------------------------------------------------------
  971.  *
  972.  * ProcessCDError --
  973.  *
  974.  *    This procedure gets called if a Windows-specific error message
  975.  *    has occurred during the execution of a common dialog or the
  976.  *    user has pressed the CANCEL button.
  977.  *
  978.  * Results:
  979.  *    If an error has indeed happened, returns a standard TCL result
  980.  *    that reports the error code in string format. If the user has
  981.  *    pressed the CANCEL button (dwErrorCode == 0), resets
  982.  *    interp->result to the empty string.
  983.  *
  984.  * Side effects:
  985.  *    interp->result is changed.
  986.  *
  987.  *----------------------------------------------------------------------
  988.  */
  989. static int ProcessCDError(interp, dwErrorCode, hWnd)
  990.     Tcl_Interp * interp;        /* Current interpreter. */
  991.     DWORD dwErrorCode;            /* The Windows-specific error code */
  992.     HWND hWnd;                /* window in which the error happened*/
  993. {
  994.     char *string;
  995.  
  996.     Tcl_ResetResult(interp);
  997.  
  998.     switch(dwErrorCode) {
  999.       case 0:      /* User has hit CANCEL */
  1000.     return TCL_OK;
  1001.  
  1002.       case CDERR_DIALOGFAILURE:   string="CDERR_DIALOGFAILURE";      break;
  1003.       case CDERR_STRUCTSIZE:      string="CDERR_STRUCTSIZE";           break;
  1004.       case CDERR_INITIALIZATION:  string="CDERR_INITIALIZATION";       break;
  1005.       case CDERR_NOTEMPLATE:      string="CDERR_NOTEMPLATE";           break;
  1006.       case CDERR_NOHINSTANCE:     string="CDERR_NOHINSTANCE";       break;
  1007.       case CDERR_LOADSTRFAILURE:  string="CDERR_LOADSTRFAILURE";       break;
  1008.       case CDERR_FINDRESFAILURE:  string="CDERR_FINDRESFAILURE";       break;
  1009.       case CDERR_LOADRESFAILURE:  string="CDERR_LOADRESFAILURE";       break;
  1010.       case CDERR_LOCKRESFAILURE:  string="CDERR_LOCKRESFAILURE";       break;
  1011.       case CDERR_MEMALLOCFAILURE: string="CDERR_MEMALLOCFAILURE";       break;
  1012.       case CDERR_MEMLOCKFAILURE:  string="CDERR_MEMLOCKFAILURE";       break;
  1013.       case CDERR_NOHOOK:          string="CDERR_NOHOOK";            break;
  1014.       case PDERR_SETUPFAILURE:    string="PDERR_SETUPFAILURE";       break;
  1015.       case PDERR_PARSEFAILURE:    string="PDERR_PARSEFAILURE";       break;
  1016.       case PDERR_RETDEFFAILURE:   string="PDERR_RETDEFFAILURE";       break;
  1017.       case PDERR_LOADDRVFAILURE:  string="PDERR_LOADDRVFAILURE";       break;
  1018.       case PDERR_GETDEVMODEFAIL:  string="PDERR_GETDEVMODEFAIL";       break;
  1019.       case PDERR_INITFAILURE:     string="PDERR_INITFAILURE";       break;
  1020.       case PDERR_NODEVICES:       string="PDERR_NODEVICES";           break;
  1021.       case PDERR_NODEFAULTPRN:    string="PDERR_NODEFAULTPRN";       break;
  1022.       case PDERR_DNDMMISMATCH:    string="PDERR_DNDMMISMATCH";       break;
  1023.       case PDERR_CREATEICFAILURE: string="PDERR_CREATEICFAILURE";       break;
  1024.       case PDERR_PRINTERNOTFOUND: string="PDERR_PRINTERNOTFOUND";       break;
  1025.       case CFERR_NOFONTS:         string="CFERR_NOFONTS";            break;
  1026.       case FNERR_SUBCLASSFAILURE: string="FNERR_SUBCLASSFAILURE";       break;
  1027.       case FNERR_INVALIDFILENAME: string="FNERR_INVALIDFILENAME";       break;
  1028.       case FNERR_BUFFERTOOSMALL:  string="FNERR_BUFFERTOOSMALL";       break;
  1029.     
  1030.       default:
  1031.     string="unknown error";
  1032.     }
  1033.  
  1034.     Tcl_AppendResult(interp, "Win32 internal error: ", string, NULL); 
  1035.     return TCL_ERROR;
  1036. }
  1037.